home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops source / More classes / MW documents / Info_run < prev    next >
Text File  |  1990-11-15  |  4KB  |  138 lines
  1. \ The info_run class is used to implement fmt_run and para_run.
  2. \ An info_run consists of a set of items, each of which starts with a
  3. \ 4-byte offset (aligned) followed by a number of bytes of information.
  4. \ This particular number is fixed for each object of this class, but
  5. \ may vary between objects.  It must be even, though.
  6.  
  7.     0    value    STRT        \ Used in FIXUP: and MOVE: because we can
  8.                 \ only have 5 locals!
  9.  
  10.  
  11. :class    (INFO_RUN)    super(  bytestring  )
  12.  
  13.     int    INFOSIZE
  14.  
  15. :m INFOSIZE:    get: infoSize  ;m
  16. :m ITEMSIZE:    get: infoSize  4+  ;m
  17. :m SETINFOSIZE:    put: infoSize  ;m
  18.  
  19. :m SKIP_INFO:    get: infoSize  skip: self  ;m
  20. :m SKIP_ITEM:    get: infoSize  4+  skip: self  ;m
  21. :m <SKIP_INFO:    get: infoSize  negate  skip: self  ;m
  22. :m <SKIP_ITEM:    get: infoSize  4+ negate  skip: self  ;m
  23.  
  24. :m OFFS:    ^1st: self  @  ;m
  25.  
  26. :m NEW_ITEM:  { offs -- }    \ Sets up a new item - all zero initially.
  27.                 \ Leaves POS at the info field.
  28.     pad  itemSize: self  2dup  erase   offs pad !
  29.     pos: self  0dup
  30.     IF
  31.         ^1st: self  itemSize: self  -  @  offs  =
  32.     THEN
  33.     IF  ( same offset as previous entry - overwrite prev entry )
  34.         <skip_item: self  ovwr: self
  35.     ELSE
  36.         insert: self
  37.     THEN
  38.     <skip_info: self  ;m
  39.  
  40. :m FIND_POSN:  { offs reset? -- }
  41.     reset?  IF  reset: self  THEN
  42.     BEGIN
  43.         len: self  0EXIT
  44.         ^1st: self  @  offs  >  ?EXIT
  45.         skip_item: self
  46.     AGAIN  ;m
  47.  
  48. :m FIXUP:  { offs oldlen newlen \ nxt n -- }
  49.  
  50. \ Makes the necessary adjustments when some text being pointed to by this
  51. \ info_run is about to be replaced.  To save time, we assume that SELF only
  52. \ has to be scanned from its current position.  Remember to RESET: it if
  53. \ there's any doubt.
  54.  
  55.     pos: self -> strt  newlen oldlen - -> n
  56.     nolim: self
  57.     BEGIN     \ loop to get up to the place where we have to do anything
  58.         len: self  NIF  strt >pos: self  EXIT  THEN
  59.         nxtL: self -> nxt  offs nxt >
  60.     WHILE
  61.         skip_info: self
  62.     REPEAT
  63.     BEGIN     \ loop to coerce any changes within the old string
  64.          \ to go to the right of the new string
  65.         nxt offs -  oldlen <
  66.     WHILE
  67.         newlen offs +  -4 skip: self  >nxtL: self
  68.         skip_info: self
  69.         len: self  NIF  strt >pos: self  EXIT  THEN
  70.         nxtL: self -> nxt
  71.     REPEAT
  72.     BEGIN     \ loop to adjust the rest of the offsets
  73.         nxt n +  -4 skip: self  >nxtL: self
  74.         skip_info: self
  75.         len: self  NIF  strt >pos: self  EXIT  THEN
  76.         nxtL: self -> nxt
  77.     AGAIN  ;m
  78.  
  79. ;class
  80.  
  81. (info_run)    TEMP
  82. objPtr        TheIR        \ Class will be set to info_run
  83.  
  84. :class  INFO_RUN  super(  (info_run)  )
  85.  
  86. ' theIR  set_to_class  info_run
  87.  
  88. :m MOVE:  { pos len trg \ end dist -- }
  89.  
  90. \ Sets up Self for when some text is to be moved.  The text is delimited
  91. \ by pos and len in the text string, and will be moved to the offset trg.
  92.  
  93.     new: temp  infosize: self  setinfosize: temp
  94.     pos 1-      true  find_posn: self   pos: self  -> strt
  95.     pos len +  false  find_posn: self   pos: self  -> end
  96.     strt  >pos: self   end  >lim: self
  97.     ^base ->: temp  delete: self  nolim: self
  98.     pos len 0  fixup: self
  99.     len --> trg
  100.     trg false  find_posn: self
  101.     trg 0 len  fixup: self        \ For insert
  102.     trg pos -  -> dist
  103.     BEGIN
  104.         len: temp
  105.     WHILE
  106.         dist  ^1st: temp  +!
  107.         skip_item: temp
  108.     REPEAT
  109.     reset: temp  temp $insert: self
  110. \    reset: temp  len: temp
  111. \    IF
  112. \        nxtL: temp  new_item: self
  113. \          \ We don't just insert as prev item may have same offset
  114. \        temp  $ovwr: self
  115. \    THEN
  116.     reset: self  release: temp  ;m
  117.  
  118. :m CUT:  { pos len IRobj \ strt end -- }
  119.     IRobj -> theIR
  120.     infosize: theIR  setinfosize: self
  121.     pos 1-      true  find_posn: theIR   pos: theIR  -> strt
  122.     pos len +  false  find_posn: theIR   pos: theIR  -> end
  123.     strt  >pos: theIR   end  >lim: theIR
  124.     theIR ->: self  delete: theIR  reset: self  nolim: theIR
  125.     pos len 0  fixup: theIR
  126.     0 pos   0  fixup: self  ;m
  127.  
  128.  
  129. :m PASTE:  { pos len IRobj -- }
  130.     IRobj -> theIR  reset: theIR
  131.     pos true  find_posn: self
  132.     pos 0  len  fixup: self        \ For insert
  133.     0  0   pos  fixup: theIR
  134.     reset: theIR  theIR  $insert: self
  135.     reset: self  ;m
  136.  
  137. ;class
  138.